           MO4PAINT
Paint en FORTH pour le Thomson MO5
          Juin 2013
     Par Dominique Contant
    http://forthretro.new.fr
==========================================

Remerciements :
-	Aux nombreux membres du forum :
http://forum.system-cfg.com/index.php
-	Particulirement Samuel Devulder, l'ami _sam_, pour les procdures spcifiques EI, DI, FOND, FORME, BITDUP, /8 et ses prcieux conseils
-	Daniel Coulom pour son mulateur dcmoto  2013.03.10 et toute la documentation sur le MO5.

I  UTILITAIRES :
Emulateur Dcmoto2013.03.10 de Daniel Coulom
	http://dcmoto.free.fr/emulateur/index.html
Compilateur Forth
	http://dcmoto.free.fr/programmes/forth-mo5/index.html

Installer FORTH depuis la K7 :  FORTH-MO5-MO5.K7
Depuis le Forth installer lditeur.
Charger la K7 MO4PAINT
Depuis le Forth : 1 9 CLOAD PAINT
Une fois charg, compiler le programme par
    1 LOAD
    ( Le programme chargera automatiquement la partie PAIN2 )
 Compiler la partie 2 par
    1 LOAD
Lancer le programme par MO4PAINT

II CONSIGNES
     Utiliser :
   ---
  Flches pour le dplacement du curseur
---
  Touche 1 pour le trac des points - 
  Touche 0 Pour effacer les points
  Touche T pour rendre le curseur transparent
---
  Touche R pour faire un rectangle
  Flches pour ajuster les dimensions
  Touche R (  nouveau) pour valider le rectangle
  Touche U pour annuler le trac
---
  Touche C pour faire un cercle
  Flches pour ajuster les dimensions
  Touche C (  nouveau) pour valider le cercle
  Touche U pour annuler le trac
---
  Touche E pour faire une ellipse
  Flches pour ajuster les dimensions
  Touche E (  nouveau) pour valider l'ellipse
  Touche U pour annuler le trac
---
  Touche L pour faire une ligne
  Flches pour ajuster les dimensions
  Touche L (  nouveau) pour valider la ligne
  Touche U pour annuler le trac
---
  Touche F pour colorier une figure ferme
    en positionnant le curseur  l'intrieur.
    Remplissage couleur Encre ou Fond (si touche Z
    valide prcdemment)
  Touche U pour annuler le remplissage
---
  Touche K pour effacer l'cran
---
  Touche G pour faire une Loupe x2
  Touche G (  nouveau) pour sortir
  ---
  Touche X pour copier une rgion du dessin
  Fleches pour le dplacement du rectangle
  Touche V pour coller le rectangle
---

  Touche <espace> pour accder au menu 'Couleurs'
   Choisir la couleur de fond ou de forme
  Touche <espace> pour sortir du menu 'Couleurs'
---
            ou

  Par la touche W depuis le "menu Couleurs"
  sauvegarder son image
  Saisir  la demande un nom de fichier 
  qui s'enregistrera en 2 parties.
---
  Par la touche X depuis le "menu Couleurs"
  rcuprer son image
  Saisir  la demande le nom de fichier 
  qui se rcuprera et s'affichera.
  ---
  Par la touche Z le remplissage (F) se fera 
  selon la couleur de FOND et non plus la couleur ENCRE
  La touche Z ne sert qu'une fois, revenir au menu si
  l'on dsire un autre remplissage de fond
---

III  PROJET PAINT

( /======================DEBUT DU LISTING =======================)

: TASK ;			/ Borne suprieure programme
HEX				/Mode Hexadcimal

( /----Dclaration des Constantes et Variables----)
13F CONSTANT XMAX		/ Borne suprieure colonnes cran
C7 CONSTANT YMAX		/ Borne suprieure lignes cran
0 VARIABLE XNOW		        / Coordonnes dbut trac figures
0 VARIABLE YNOW		        / Coordonnes dbut trac figures
0 VARIABLE XA			/ Coordonnes curseur
0 VARIABLE YA			/ Coordonnes curseur
0 VARIABLE NEGATIF		/ Flag mode inverse : 1= Inverse un point 0 = ninverse pas
0 VARIABLE STEP			/ Utilis pour laffichage partiel des figures 
0 VARIABLE FONDPLOT		/ Mode utilis par FILL  Remplis figure de bit 0 couleur COL-FOND
0 VARIABLE COLOUR		/ Couleur de lEncre
0 VARIABLE TR			/ Flag mode curseur : 1 = Transparent  0 = Affecte lcran
0 CONSTANT CASE IMMEDIATE	/ Definition de CASE OF ENDOF ENDCASE
0 VARIABLE COL-FOND		/ Variable Couleur de Fond
0 VARIABLE INCOLOR 		/ Flag 1 = Naffecte pas couleur de fond 0= affecte
1 VARIABLE FLAG-SAVE		/ Flag Provisoire tat SAVE


( /Variables utilises par ellipse)
0 VARIABLE YRADIUS
0 VARIABLE XRADIUS
0 VARIABLE ELLERROR
0 VARIABLE STOPX
0 VARIABLE STOPY

( /Variables utilises  la fois par Cercle / Ligne / Ellipse)
0 VARIABLE X1			
0 VARIABLE Y1
0 VARIABLE INCR2
0 VARIABLE INCR1
0 VARIABLE DX
0 VARIABLE DY

( /Variables utilises par  Fill) 
0 VARIABLE XLEFT
0 VARIABLE XRIGHT
0 VARIABLE FLAG
0 VARIABLE STACK

( /Variables utilises  la fois par Glass / Copy)
0 VARIABLE ADR-AFFI
0 VARIABLE ADRSPRITE
 
 
( /----Dfinitions FORTH absentes de cette version compilateur----)

( a, b ...a,b,a,b)
: DDUP OVER OVER ;

( X,Y,...) ( /Print adresse X Y)
: AT LOCATE ;

( n, ...flag)
: 0> 0 > ;

( adr...) ( / 0 dans adr)
: 0SET 0 SWAP ! ; 

( nflag)
: NOT 0 = ;

( a,b ...)
: DDROP DROP DROP ; 

( n ... Flag)
: <= > NOT ; 

( a....a/8,reste)
CREATE /8 ECC1 , 4756 , 4756 , 4756 , 0EB4 , SMUDGE  

( /Dfinition de CASE.. OF.. ENDOF.. ENDCASE)

: OF 1 + >R COMPILE OVER COMPILE = [COMPILE] IF COMPILE DROP R> ; IMMEDIATE  
: ENDOF >R [COMPILE] ELSE R> ; IMMEDIATE  
: ENDCASE COMPILE DROP 0 DO [COMPILE] ENDIF LOOP ; IMMEDIATE

( /----Dfinitions de manipulation cran----)

( /Disable Interrupt)
CREATE DI 1A50 , 0EB6 , SMUDGE

( /Enable Interrupt)
CREATE EI 1CAF , 0EB6 , SMUDGE

( /Switch pages FOND/FORME)
: FOND A7C0 DUP C@ FE AND SWAP C! ;
: FORME A7C0 DUP C@ 1 OR SWAP C! ;

( /Mise  jour couleurs FOND/ENCRE)
(adresseEcran....)
: MAJ-FOND  COL-FOND SWAP OVER @ F0 AND OR SWAP ! 0 INCOLOR ! ; 
: MAJ-ENCRE  COL-FOND SWAP OVER @ 0F AND OR SWAP ! 0 INCOLOR ! ;
 
( reste /8 .... masque)
: MASK-PLOT CASE 0 OF 80 ENDOF 1 OF 40 ENDOF 2 OF 20 ENDOF 3 OF 10 ENDOF 4 OF 8 ENDOF 5 OF 4 ENDOF 6 OF 2 ENDOF 7 OF 1 ENDOF ENDCASE ; 
: MASK-UNPLOT CASE 0 OF 7F ENDOF 1 OF BF ENDOF 2 OF DF ENDOF 3 OF EF ENDOF 4 OF F7 ENDOF 5 OF FB ENDOF 6 OF FD ENDOF 7 OF FE ENDOF ENDCASE ; 

( /----Dfinitions lmentaires graphiques----)

( X,Y....adresse, reste/8) 
: TROUVE-CELL 28 * OVER /8 + SWAP 7 AND  ; 

( adresse, reste/8....)
: (PLOT) MASK-PLOT OVER FORME C@ OR SWAP FORME C! ; 
: (UNPLOT)  MASK-UNPLOT OVER FORME C@ AND SWAP FORME C! ; 

( adresse, reste/8 ....flag)
: (?POINT) MASK-PLOT SWAP FORME C@ AND ; 

( X,Y ... Adresse, reste/8 ) ( /Si mode INCOLOR, ne pas mettre la couleur de fond  jour)
: ?MAJ-FOND TROUVE-CELL >R DUP INCOLOR @ IF DROP ELSE COL-FOND @ SWAP FOND C! ENDIF R> ; 

( X,Y...)
: UNPLOT ?MAJ-FOND (UNPLOT) ; 

( X,Y...)
: PLOT ?MAJ-FOND (PLOT) ; 

( X,Y ...flag)
: ?POINT TROUVE-CELL (?POINT) ; 

( X,Y ...) ( /Bit=0 ou 1 selon COLOUR)
: PLOT-POINT COLOUR @ IF PLOT ELSE UNPLOT ENDIF ; 

( X,Y ...) ( /Eteint bit allum, allume bit teint)
: NEGA-PLOT TROUVE-CELL DDUP (?POINT) IF (UNPLOT) ELSE (PLOT) ENDIF ; 

( ...)( /Eteint curseur allum, allume curseur teint)
: FLASH XA @ YA @ NEGA-PLOT ; 

( ...) ( /teint ou allume curseur selon COLOUR)
: DRAW XA @ YA @ PLOT-POINT ; 

( Touche...Touche) ( /Mise  jour de COLOUR selon touches 1 , 0 ou T)
: COLOUR? DUP 1B = IF 0 COLOUR ! 0 TR ! ELSE DUP A = IF 1 COLOUR ! 0 TR ! ENDIF ENDIF DUP 2C = IF 1 TR ! ENDIF ;

( X,Y ) ( /Eteint bit allum, allume bit teint si Mode NEGATIF, sinon plot un point)
: ?INV-PLOT  NEGATIF @ IF  NEGA-PLOT ELSE PLOT ENDIF ; 

( X,Y...X,Y) ( /Eteint bit allum, allume bit teint si Mode NEGATIF, sinon plot un point)
: B-POINT DDUP ?INV-PLOT ; 


( /----Procdures de copie cran----)

( /Compression-Dcompression)
CREATE (ZIP) 3630 , 8E C, 0000 , 108E , 9100 , C601 , A680 , A721 , E720 , A680 , A121 , 260C , 5C C, E720 , 8C1F , 40 C, 270E , C1FF , 26EE , 3122 , C601 , E720 , A721 , 20ED , 6C20 , 3730 , 0EB6 , SMUDGE  
CREATE (UNZIP) 3630 , 8E C, 0000 , 108E , 9100 , E620 , C1FF , 2601 , 5A C, A621 , A780 , 8C1F , 40 C, 2707 , 5A C, 26F6 , 3122 , 20E9 , 3730 , 0EB6 , SMUDGE  
: UNZIP FOND (UNZIP) ;
: ZIP FOND (ZIP) ;

( /Copie intgrale cran FOND adresse 2100)
: >CSCR-FOND 0 2100 2000 FOND CMOVE ; 

( /Copie intgrale cran FORME adresse 2100)
: >CSCR-FORME 0 2100 2000 FORME CMOVE ; 

( /Retour intgral cran FOND)
: CSCR-FOND> 2100 0 2000 FOND CMOVE ; 

( /Retour intgral cran FORME)
: CSCR-FORME> 2100 0 2000 FORME CMOVE ; 

( /Copie compresse cran FORME adresse 9100)
: >COPIE-EC ZIP >CSCR-FORME ; 

( /Retour compress cran FORME)
: COPIE-EC> UNZIP CSCR-FORME> ; 

( /----Procdures SAVE/CLOAD cran----)

: DEBUT-SAVE DROP 1 9 10 0 AT ." FICHIER ? " QUERY  ." SAVING" COPIE-EC> 0 FLAG-SAVE ! 1+ SWAP OVER OVER ; 
: LOOP-SAVE DO ?TERMINAL IF WARM ENDIF [ 5840 , ] 0A ?ERROR LOOP ; 
: SAVE-SCR DEBUT-SAVE >R >R BL WORD HERE DUP DUP >R C@ 1+ DUP R> C! 6 MIN + DUP >R 31 OVER C!  1+ 0F BLANKS >CSCR-FOND LOOP-SAVE 32 R> C! R> R> >CSCR-FORME LOOP-SAVE 19 ; 
: DEBUT-LOAD DROP 1 9 10 0 AT ." FICHIER ?" QUERY  ." LOADING" COPIE-EC> 0 FLAG-SAVE ! 1+ SWAP OVER OVER ; 
: LOOP-LOAD DO BEGIN [ 57CC , ] A ?ERROR ?TERMINAL IF WARM ENDIF IF  [ 58CD , ] A ?ERROR ELSE [ >R >R ] AGAIN [ R> R> ] ENDIF LOOP ; 
: LOAD-SCR DEBUT-LOAD >R >R BL WORD HERE DUP DUP >R C@ 1+ DUP R> C! 6 MIN + DUP >R 31 OVER C! 1+ 0F BLANKS  LOOP-LOAD CSCR-FOND> 32 R> C! R> R> LOOP-LOAD CSCR-FORME> 19 ; 

( /----Procdures affichage position curseur----)

: AFF 0 0 AT ." X = " XA @ . ."  Y = " YA @ . ."    " ; 

( /----Procdures impression cran Choix des Couleurs-----)

: PRINT-COLOUR 10 0 DO I DUP 2 * 61B + FOND C! LOOP ; 
: MENU2  3  3 AT ." 0 1 2 3 4 5 6 7 8 9 A B C D E F " ; 
: MENU3  6 03 AT ." G H I J K L M N O P Q R S T U V  " ; 
: ?FILL-FOND 14 = IF 1 FONDPLOT ! ENDIF ;
: MENU4 0A 00 AT ."   w         X                Y           " 0B 00 AT ." SAVE      LOAD            INCOLORE " 0D 0 AT ." FILL FOND = Z " ; 
: MENU1  PRINT-COLOUR 1 6 AT ." CHOISIR COULEUR DE FOND " 8 7 AT ." CHOISIR COULEUR ENCRE " MENU2 MENU3 MENU4 ; 
: ?S-C-I CASE 9 OF SAVE-SCR ENDOF 11 OF LOAD-SCR ENDOF 34 OF 1 INCOLOR ! ENDOF ENDCASE ; 
: ?COL-FOND CASE 1B OF 0 MAJ-FOND ENDOF 0A OF 1 MAJ-FOND ENDOF 12 OF 2 MAJ-FOND ENDOF 1A OF 3 MAJ-FOND ENDOF 22 OF 4 MAJ-FOND ENDOF 2A OF 5 MAJ-FOND ENDOF 32 OF  6 MAJ-FOND ENDOF 33 OF  7 MAJ-FOND ENDOF 2B OF 8 MAJ-FOND ENDOF 23 OF 9 MAJ-FOND ENDOF 0C OF A MAJ-FOND ENDOF 17 OF B MAJ-FOND ENDOF 07 OF  C MAJ-FOND ENDOF 1E OF D MAJ-FOND ENDOF 1C OF  E MAJ-FOND ENDOF 26 OF F MAJ-FOND ENDOF ENDCASE ; 
: ?COL-ENCRE CASE 2E OF 0 MAJ-ENCRE ENDOF 36 OF 10 MAJ-ENCRE ENDOF 2D OF 20 MAJ-ENCRE ENDOF 37 OF 30 MAJ-ENCRE ENDOF 2F OF 40 MAJ-ENCRE ENDOF 27 OF 50 MAJ-ENCRE ENDOF 1F OF 60 MAJ-ENCRE ENDOF 39 OF 70 MAJ-ENCRE ENDOF 25 OF 80 MAJ-ENCRE ENDOF 1D OF 90 MAJ-ENCRE ENDOF 0E OF A0 MAJ-ENCRE ENDOF 24 OF B0 MAJ-ENCRE ENDOF 16 OF C0 MAJ-ENCRE ENDOF 2C OF D0 MAJ-ENCRE ENDOF 35 OF E0 MAJ-ENCRE ENDOF 0F OF F0 MAJ-ENCRE ENDOF ENDCASE ; 
: INPUT-MENU >COPIE-EC CLS MENU1 BEGIN KEYF DUP ?COL-FOND DUP ?COL-ENCRE DUP ?S-C-I DUP ?FILL-FOND 19 = UNTIL FLAG-SAVE @ IF COPIE-EC> ENDIF 1 FLAG-SAVE ! ; 

( ----Procdures mouvement curseur et pointers ----)

: X+ 1 XA +! AFF ;
: X- -1 XA +! AFF ;
: Y+ 1 YA +! AFF ;
: Y- -1 YA +! AFF ;
: -Y STEP @ - ;
: +Y STEP @ + ;
: -X SWAP -Y SWAP ;
: +X SWAP +Y SWAP ;

( toucheClavier ...toucheClavier)
: UP DUP 8 = YA @ 0 > AND IF Y- ENDIF ; 
: DOWN DUP 18 = YA @ YMAX < AND IF Y+ ENDIF ; 
: RIGHT DUP 20 = XA @ XMAX < AND IF X+ ENDIF ; 
: LEFT DUP 10 = XA @ 0 > AND IF X- ENDIF ; 

( Touche...Touche) ( /Dplacement Sprite)
: HAUT DUP 8 = YNOW @ 1- SWAP OVER 24 > AND IF YNOW ! -1 YA +! ELSE DROP ENDIF ; 
: BAS DUP 18 = YNOW @ 1+ SWAP OVER 140 = NOT AND IF YNOW ! 1 YA +! ELSE DROP ENDIF ; 
: DROIT DUP 20 = XNOW @ 8 + SWAP OVER 140 < AND IF XNOW ! 8 XA +! ELSE DROP ENDIF ;
: GAUCHE DUP 10 = XNOW @ 8 - SWAP OVER 20 > AND IF XNOW ! -8 XA +! ELSE DROP ENDIF ; 


( /----Procdures diverses ----)

( /Controle fleches curseur)
: INPUT2 KEYF COLOUR? UP DOWN  LEFT RIGHT ; 

( /Saut pour impression dun point / 4)
: STEP! XA @ XNOW @ - ABS YA @ YNOW @ - ABS MAX 4 / 1+ STEP ! ; 

( /vite repetition de touches)
: BEEP BEGIN DUP KEYF = NOT UNTIL DROP ;

( /Dbut trac des figures - XY NOW=  position depart curseur)
: DEBUT XA @ XNOW ! YA @ YNOW ! ; 

( /WARM Start  Curseur au milieu cran)
: INIT CLS 64 YA ! A0 XA ! 0 COLOUR ! 1 TR ! 70 COL-FOND ! 0 INCOLOR ! ; 

( /-----------procedures trac RECTANGLE-------)

: P1Q1 DO I YNOW @ ?INV-PLOT I YA @ ?INV-PLOT STEP @ +LOOP ; 
: P2Q1 DO XNOW @ I ?INV-PLOT XA @ I ?INV-PLOT STEP @ +LOOP ; 
: Q1 XA @ XNOW @ P1Q1 YA @ YNOW @ P2Q1 ; 
: Q2 XNOW @ XA @ P1Q1 YA @ YNOW @ P2Q1 ; 
: Q3 XNOW @ XA @ P1Q1 YNOW @ YA @ P2Q1 ; 
: Q4 XA @ XNOW @ P1Q1 YNOW @ YA @ P2Q1 ; 
: (DRAWRECT) XA @ XNOW @ > IF YA @ YNOW @ > IF Q1 ELSE Q4 ENDIF ELSE YA @ YNOW @ > IF Q2 ELSE Q3 ENDIF ENDIF ; 
: DRAWRECT DEBUT BEGIN KEYF 24 = NOT WHILE STEP! (DRAWRECT) (DRAWRECT) INPUT2 DROP REPEAT 0 NEGATIF ! 1 STEP ! (DRAWRECT) XA @ YA @ ?INV-PLOT ;   

( /-----------procedures trac ELLIPSE-------)

: PL4EL XNOW @ X1 @ + DUP YNOW @ Y1 @ + DUP >R ?INV-PLOT YNOW @ Y1 @ - ?INV-PLOT XNOW @ X1 @ - DUP R> ?INV-PLOT YNOW @ Y1 @ - ?INV-PLOT ; 
: ELPART2 YRADIUS @ DUP >R DUP Y1 ! DUP * DX ! 1 I DUP + - XRADIUS @ DUP * * DY ! ELLERROR 0SET STOPX 0SET X1 0SET R> INCR1 @ * STOPY ! BEGIN STOPX @ STOPY @ > NOT WHILE PL4EL STEP @ X1 +! INCR2 @ DUP STOPX +! DX @ ELLERROR +! DX +! ELLERROR @ DUP + DY @ + 0> IF 0 STEP @ - Y1 +! 0 INCR1 @ DUP >R - STOPY +! DY @ ELLERROR +! R> DY +! ENDIF REPEAT ; 
: ELPART1 YA @ YNOW @ - ABS YRADIUS ! XA @ XNOW @ - ABS 1+ DUP DUP >R XRADIUS ! DUP * DUP + STEP @ * INCR1 ! YRADIUS @ DUP * DUP DUP + STEP @ * INCR2 ! I X1 ! 1 I DUP + - * DX ! I DUP * DY ! R> INCR2 @ * STOPX ! Y1 0SET ELLERROR 0SET STOPY 0SET BEGIN STOPX @ STOPY @ < NOT WHILE PL4EL STEP @ Y1 +! INCR1 @ DUP STOPY +! DY @ ELLERROR +! DY +! ELLERROR @ DUP + DX @ + 0> IF 0 STEP @ - X1 +! 0 INCR2 @ DUP DX +! - STOPX +! DX @ ELLERROR +! ENDIF REPEAT ; 
: (ELLIPSE) ELPART1 ELPART2 ; 
: ELLIPSE DEBUT BEGIN KEYF 1C = NOT WHILE STEP! (ELLIPSE) (ELLIPSE) INPUT2 DROP REPEAT 0 NEGATIF ! 1 STEP ! (ELLIPSE) ; 

( /-----------procedures trac LIGNE-------)

: P1 DY @ DUP DUP + INCR1 ! DX @ - DUP + INCR2 ! OVER XNOW @ ; 
: P2 DDROP XNOW @ YNOW @ ; 
: P3 DX @ DUP DUP + INCR1 ! DY @ - DUP + INCR2 ! DUP YNOW @ ; 
: P4 OVER XNOW @ - DUP ABS DX ! OVER YNOW @ - DUP ABS DY ! ; 
: P6 INCR1 @ DX @ - DX @ 0 ; 
: P7 INCR1 @ DY @ - DY @ 0 ;    
: LINE0<M<1 P1 > IF P2 ENDIF DDUP ?INV-PLOT P6 DO DUP 0< IF >R +X B-POINT R> INCR1 @ + ELSE >R +X +Y B-POINT R> INCR2 @ + ENDIF STEP @ +LOOP DROP DDROP ; 
: LINE1<M<Z P3 > IF P2 ENDIF DDUP ?INV-PLOT P7 DO DUP 0< IF >R +Y B-POINT R> INCR1 @ + ELSE >R +X +Y B-POINT R> INCR2 @ + ENDIF STEP @ +LOOP DROP DDROP ; 
: LINE-1<M<0 P1 > IF P2 ENDIF DDUP ?INV-PLOT P6 DO DUP 0< IF >R +X B-POINT R> INCR1 @ + ELSE >R +X -Y B-POINT R> INCR2 @ + ENDIF STEP @ +LOOP DROP DDROP ; 
: LINE-Z<M<-1 P3 > IF P2 ENDIF DDUP ?INV-PLOT P7 DO DUP 0< IF >R +Y B-POINT R> INCR1 @ + ELSE >R -X +Y B-POINT R> INCR2 @ + ENDIF STEP @ +LOOP DROP DDROP ; 
: LINEZ DUP YNOW @ > IF P2 ENDIF DDUP ?INV-PLOT 0 DY @ 0 DO >R +Y B-POINT R> STEP @ +LOOP DROP DDROP ; 
: LINE0 OVER XNOW @ > IF P2 ENDIF DDUP ?INV-PLOT 0 DX @ 0 DO >R +X B-POINT R> STEP @ +LOOP DROP DDROP ; 
: (LINE*) XA @ YA @ P4 XOR 0< DY @ IF DX @ IF IF DX @ DY @ > IF LINE-1<M<0 ELSE LINE-Z<M<-1 ENDIF ELSE DX @ DY @ > IF LINE0<M<1 ELSE LINE1<M<Z ENDIF ENDIF ELSE DROP LINEZ ENDIF ELSE DROP LINE0 ENDIF ; 
: DRAWLINE DEBUT BEGIN KEYF 27 = NOT WHILE STEP! (LINE*) (LINE*) INPUT2 DROP REPEAT 0 NEGATIF ! 1 STEP ! (LINE*) ; 

( /-----------procdures trac de remplissage FILL -------)

: ?F-POINT TROUVE-CELL DDUP (?POINT) >R DROP FONDPLOT @ IF FOND C@ COL-FOND @ = R> OR ELSE DROP R> ENDIF ; 
: ?FOND-PLOT FONDPLOT @ IF UNPLOT  ELSE ?INV-PLOT ENDIF ; 
: RIGHT> 1 X1 +! BEGIN X1 @ DUP Y1 @   ?POINT 0= SWAP XMAX > NOT AND WHILE X1 @ Y1 @ ?FOND-PLOT 1 X1 +! REPEAT X1 @ 1 - XRIGHT ! ; 
: LEFT> -1 X1 +! BEGIN X1 @ DUP Y1 @   ?POINT 0= SWAP 0 < NOT AND WHILE X1 @ Y1 @ ?FOND-PLOT -1 X1 +! REPEAT X1 @ 1+ XLEFT ! ;
: (SCAN) BEGIN X1 @ XRIGHT @ <= WHILE 0 FLAG ! BEGIN X1 @ Y1 @ ?F-POINT 0= X1 @ XRIGHT @ <= AND WHILE 1 FLAG ! 1 X1 +! REPEAT FLAG @ IF X1 @ Y1 @ ?F-POINT 0= X1 @ XRIGHT @ = AND IF X1 @ Y1 @ ELSE X1 @ 1 - Y1 @ ENDIF ENDIF X1 @ BEGIN X1 @ Y1 @ ?F-POINT X1 @ XRIGHT @ < AND WHILE  1 X1 +! REPEAT X1 @ = IF 1 X1 +! ENDIF REPEAT ;                                                                                                                                               
: *FILL* XA @ YA @ SP@ 4 + STACK ! BEGIN Y1 ! X1 ! X1 @ Y1 @ ?FOND-PLOT X1 @ RIGHT> X1 ! LEFT> XLEFT @ X1 ! Y1 @ YMAX 1 -  < IF 1 Y1 +! ENDIF (SCAN) XLEFT @ X1 ! Y1 @ 2 < NOT IF -2 Y1 +! ENDIF (SCAN) SP@ STACK @ = UNTIL ; 

( /-----------procedures trac de CERCLE -------)

: PL8CI XNOW @ X1 @ + DUP YNOW @ Y1 @ + ?INV-PLOT YNOW @ Y1 @ - ?INV-PLOT XNOW @ X1 @ - DUP YNOW @ Y1 @ + ?INV-PLOT YNOW @ Y1 @ - ?INV-PLOT XNOW @ Y1 @ + DUP YNOW @ X1 @ + ?INV-PLOT YNOW @ X1 @ - ?INV-PLOT XNOW @ Y1 @ - DUP YNOW @ X1 @ + ?INV-PLOT YNOW @ X1 @ - ?INV-PLOT ; 
: PLOTCIRC XA @ XNOW @ - ABS DUP DUP X1 ! INCR1 ! DUP + 1 SWAP - DX ! 0 DUP Y1 ! INCR2 ! STEP @ DY ! BEGIN X1 @ Y1 @ < NOT WHILE PL8CI STEP @ Y1 +! DY @ INCR2 +! STEP @ DUP + DY +! INCR2 @ DUP + DX @ + 0> IF 0 STEP @ - X1 +! DX @ INCR2 +! STEP @ DUP + DX +! ENDIF REPEAT ; 
: DRAWCIR DEBUT BEGIN KEYF 7 = NOT WHILE STEP! PLOTCIRC PLOTCIRC INPUT2 DROP REPEAT 0 NEGATIF ! 1 STEP ! PLOTCIRC ;             

( /-----------procedures loupe GLASS -------)

( /Byte ABCDEFGH -> AABBCCDD EEFFGGHH)                                                   
: BITDUP 00FF AND DUP 10 * OR 0F0F AND DUP 04 * OR 3333 AND DUP 02 * OR 5555 AND 3 * ; 
: LIMITXY YA DUP @ 9 MAX BE MIN SWAP ! XA DUP @ 7 MAX 137 MIN SWAP ! ; 
: CELLSPRITE XA @ YA @ 9 - TROUVE-CELL DROP ADRSPRITE ! ; 
: LOOPSPRITE DUP 2A8 + SWAP DO I FOND C@ OVER C! 12 + I FORME C@ OVER C! 11 - 28 +LOOP ;
: COPYSPRITE LIMITXY CELLSPRITE 4050 ADRSPRITE @ LOOPSPRITE 12 + ADRSPRITE @ 1+ LOOPSPRITE DROP ; 
: LIMIXY-AFFI XA DUP @ 8 MAX SWAP ! YA DUP @ 12 MAX B5 MIN SWAP ! ; 
: IMP-RECT LIMIXY-AFFI XA @ /8 1- 8 * DUP XA ! 20 + XNOW ! YA @ DUP 12 - YA ! 11 + YNOW ! ; 
: AD-AFFI XA @ YA @ TROUVE-CELL DROP ADR-AFFI ! ; 
: DRAWFOND DUP 11 + SWAP DO I C@ DUP 100 * + OVER OVER OVER 28 + FOND ! ! 50 + LOOP  DROP ; 
: DRAWFORME DUP 11 + SWAP DO I C@ BITDUP OVER OVER OVER 28 + FORME ! ! 50 + LOOP DROP ; 
: DRAWSPRITE ADR-AFFI @ DUP DUP 4050 DRAWFOND 4062 DRAWFORME 2 + DUP 4073 DRAWFOND 4085 DRAWFORME ; 
: DRAWGLASS  COPYSPRITE IMP-RECT AD-AFFI 1 NEGATIF ! (DRAWRECT) DRAWSPRITE BEGIN KEYF 2E = (DRAWRECT) UNTIL ; 

( /-----------procedures COPY/PASTE -------)

: DRAWFOND2 DUP 23 + SWAP DO I C@ OVER FOND C! 28 + LOOP  DROP ; 
: DRAWFORME2 DUP 23 + SWAP DO I C@ OVER  FORME C! 28 + LOOP DROP ; 
: LOOPSPRITE2 DUP 578 + SWAP DO I FOND C@ OVER C! 24 + I FORME C@ OVER C! 23 - 28 +LOOP ; 
: COPYSPRITE2 LIMITXY IMP-RECT AD-AFFI 4050 ADR-AFFI @ LOOPSPRITE2 24 + ADR-AFFI  @ 1+ LOOPSPRITE2 24 + ADR-AFFI @ 2 + LOOPSPRITE2 24 + ADR-AFFI @ 3 + LOOPSPRITE2 DROP ; 
: DRAWSPRITE2 AD-AFFI ADR-AFFI @ DUP DUP 4050 DRAWFOND2 4074 DRAWFORME2 1 + DUP DUP 4097 DRAWFOND2 40BB  DRAWFORME2 1 + DUP DUP 40DE DRAWFOND2 4102  DRAWFORME2 1 + DUP 4125 DRAWFOND2 4149 DRAWFORME2 ; 

( /-----------Lancement des procdures -------)

( Touche...Touche)
: ?GLASS 2E = IF 2E BEEP XA @ YA @ >COPIE-EC 3 STEP ! DRAWGLASS COPIE-EC> YA ! XA ! 1 TR ! ENDIF ;
: ?FILL 26 = IF 26 BEEP >COPIE-EC 0 NEGATIF ! *FILL* 1 TR ! 0 FONDPLOT ! ENDIF ; 
: ?RECT 24 = IF 24 BEEP >COPIE-EC 1 NEGATIF ! DRAWRECT 1 TR ! ENDIF ; 
: ?ELLI 1C = IF 1C BEEP >COPIE-EC 1 NEGATIF ! ELLIPSE 1 TR ! ENDIF ; 
: ?LINE 27 = IF 27 BEEP >COPIE-EC 1 NEGATIF ! DRAWLINE 1 TR ! ENDIF ; 
: ?U 35 = IF 35 BEEP COPIE-EC> 1 TR ! ENDIF ; 
: ?CIRC 7 = IF 7 BEEP >COPIE-EC 1 NEGATIF ! DRAWCIR 1 TR ! ENDIF ; 
: ?KLEAR 2F = IF 2F BEEP INIT ENDIF ; 
: ?DEPLCOP KEYF HAUT BAS DROIT GAUCHE ; 
: ?COPY 11 = IF 11 BEEP XA @ YA @ >COPIE-EC 3 STEP ! 1 NEGATIF ! COPYSPRITE2 BEGIN ?DEPLCOP (DRAWRECT) (DRAWRECT) F = UNTIL 1 TR ! DRAWSPRITE2 YA ! XA ! ENDIF ; 
: ?INPUT KEYF COLOUR? UP DOWN LEFT RIGHT DUP ?RECT DUP ?ELLI DUP ?LINE DUP ?FILL DUP ?U DUP ?CIRC DUP ?KLEAR DUP ?GLASS DUP ?COPY DUP 19 = IF INPUT-MENU ENDIF ; 

( /-----------DEBUT PROGRAMME -------)

: MO4PAINT 7 0 COLOR DI INIT BEGIN ?INPUT TR @ NOT IF DRAW ENDIF FLASH FLASH E = UNTIL EI CLS ; DECIMAL

( /================FIN DU LISTING ======================)


IV  AMELIORATIONS POSSIBLES
     Il sera relativement ais denrichir le PAINT par de nouvelles procdures. On pourrait, par exemple, dessiner des losanges.
     Il suffirait, pour cela dcrire les procdures de trac dun losange en se souvenant que : XNOW et YNOW auraient les valeurs du dbut du losange, 
     XA et YA les coordonnes du curseur,  ?INV-PLOT imprimerait les points, STEP! reprsente les incrments, 1 NEGATIF ! passe le trac en mode ngatif 
     soit Un premier trac du losange le dessinera en ngatif, un second le dessinera en positif.  
     Ecrire une procdure ?LOSANGE telle que les procdures ?RECT, et inclure un appel dans ?INPUT en choisissant une touche clavier (touche Z par exemple).
